perm filename M11C.F4[P11,LCS]2 blob
sn#367617 filedate 1978-07-12 generic text, type T, neo UTF8
00100 CFORS3 FORTRAN UNIT GENERATOR ROUTINE
00200 C *** MUSIC V ***
00300 SUBROUTINE FORSAM
00400 DIMENSION L(8),M(8)
00500 CC DIMENSION I(15000),P(100),IP(20),L(8),M(8)
00600 COMMON I(1)/P/ P(1)/PARM/IP(1) /GENS/IGN(1)
00700 CC COMMONI,P/PARM/IP
00800 COMMON /INS/INS(1),IDEF(1) /NT/NT(1) /IOUT/IOUT(1)
00900 C INS=INSTRUMENT DEFINITIONS, IDEF=LOCATION TABLE, IOUT=OUTPUT BLOCK
01000 EQUIVALENCE(M1,M(1)),(M2,M(2)),(M3,M(3)),(M4,M(4)),(M5,M(5)),(M6,M
01100 1(6)),(M7,M(7)),(M8,M(8)),(L1,L(1)),(L2,L(2)),(L3,L(3)),(L4,L(4)),(
01200 2L5,L(5)),(L6,L(6)),(L7,L(7)),(L8,L(8)),(RN1,IRN1),(RN3,IRN3),(RN,I
01300 3RN)
01400 SFXX=FLOAT(IP(15))
01500 SFID=FLOAT(IP(12))
01600 SFI=1./SFID
01700 SFF=1./SFXX
01800 SFXX=SFID/SFXX
01900 XNFUN=IP(6)-1
02000 C COMMON INITIALIZATION OF GENERATORS
02100 N1=I(6)+2
02200 N2=INS(N1-1)-1
02300 CQQ N2=I(N1-1)-1
02400 DO 204 J1=N1,N2
02500 J2=J1-N1+1
02600 IF(INS(J1).GE.0)GO TO 201
02700 CCC IF(I(J1))200,201,201
02800 200 L(J2)=-INS(J1)
02900 M(J2)=1
03000 GO TO 204
03100 201 M(J2)=0
03200 IF(INS(J1)-26262.GT.0)GO TO 203
03300 C IF(I(J1)-26262)202,202,203
03400 CCC IF(I(J1)-262144)202,202,203
03500 C***** WHAT DOES THE BIG NUMBER DO?????
03600 C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
03700 202 L(J2)=INS(J1)+I(3)-1
03800 GO TO 204
03900 203 L(J2)=I(J1)-26262
04000 CCC203 L(J2)=I(J1)-262144
04100 C****** WHAT DOES THIS BIG NUM. DO?? ***********
04200 204 CONTINUE
04300 NSAM=I(5)
04400 N3=INS(N1-2)
04500 NGEN= N3 -100
04600 GO TO (101,102,103,104,105,106,107,108,109,110,111,112),NGEN
04700 112 RETURN
04800
04900 C UNIT GENERATORS
05000 C OUTPUT BOX
05100 101 IF(M1.GT.0)GO TO 261
05200 CCC 101 IF(M1)260,260,261
05300 260 IN1=IOUT(L1)
05400 261 CONTINUE
05500 DO 270 J3=1,NSAM
05600 IF(M1.LE.0)GO TO 265
05700 CCC IF(M1)265,265,264
05800 264 J4=L1+J3-1
05900 IN1=IOUT(J4)
06000 C************????????
06100 265 J5=L2+J3-1
06200 IOUT(J5)=IN1+IOUT(J5)
06300 270 CONTINUE
06400 RETURN
06500
06600 C OSCILLATOR
06700 102 SUM=FLOAT(NT(L5))*SFI
06800 IF(M1.GT.0)GO TO 281
06900 CCC IF(M1)280,280,281
07000 280 AMP=FLOAT(NT(L1))*SFI
07100 281 IF(M2.GT.0)GO TO 283
07200 CCC 281 IF(M2)282,282,283
07300 282 FREQ=FLOAT(NT(L2))*SFI
07400 283 CONTINUE
07500 DO 293 J3=1,NSAM
07600 J4=INT(SUM)+L4
07700 F=FLOAT(IGN(J4))
07800 CCC F=FLOAT(I(J4))
07900 C I(J4) IS IN FUNC STORAGE AREA.
08000 IF(M2.GT.0)GO TO 286
08100 CCC IF(M2)285,285,286
08200 285 SUM=SUM+FREQ
08300 GO TO 290
08400 286 J4=L2+J3-1
08500 SUM=SUM+FLOAT(NT(J4))*SFI
08600 CC 290 IF(SUM-XNFUN)288,287,287
08700 290 IF(SUM.GE.XNFUN)GO TO 287
08800 CC 287 SUM=SUM-XNFUN
08900 IF(SUM.LT.0.0)GO TO 289
09000 288 J5=L3+J3-1
09100 IF(M1.GT.0)GO TO 292
09200 CCC IF(M1)291,291,292
09300 291 IOUT(J5)=IFIX(AMP*F*SFXX)
09400 GO TO 293
09500 C**********
09600 287 SUM=SUM-XNFUN
09700 GO TO 288
09800 289 SUM=SUM+XNFUN
09900 GO TO 288
10000 C******* ABOVE FOR FM (NEG. FREQ. TO OSCIL)
10100 292 J6=L1+J3-1
10200 IOUT(J5)=IFIX(FLOAT(NT(J6))*F*SFF)
10300 293 CONTINUE
10400 IOUT(L5)=IFIX(SUM*SFID)
10500 RETURN
10600
10700 C ADD TWO BOX
10800 103 IF(M1.GT.0)GO TO 251
10900 CCC 103 IF(M1)250,250,251
11000 250 IN1=I(L1)
11100 251 IF(M2.GT.0)GO TO 253
11200 CCC 251 IF(M2)252,252,253
11300 252 IN2=I(L2)
11400 253 DO 258 J3=1,NSAM
11500 IF(M1.LE.0)GO TO 255
11600 CCC IF(M1)255,255,254
11700 254 J4=L1+J3-1
11800 IN1=I(J4)
11900 255 IF(M2.LE.0)GO TO 257
12000 CCC 255 IF(M2) 257,257,256
12100 256 J5=L2+J3-1
12200 IN2=I(J5)
12300 257 J6=L3+J3-1
12400 I(J6)=IN1+IN2
12500 258 CONTINUE
12600 RETURN
12700
12800 C RANDOM INTERPOLATING GENERATOR
12900 104 SUM=FLOAT(I(L4))*SFI
13000 IF(M1.GT.0)GO TO 311
13100 CCC IF(M1)310,310,311
13200 310 XIN1=FLOAT(I(L1))*SFI
13300 311 IF(M2.GT.0)GO TO 313
13400 CCC 311 IF(M2)312,312,313
13500 312 XIN2=FLOAT(I(L2))*SFI
13600 313 IRN1=I(L5)
13700 IRN3=I(L6)
13800 DO 340 J3=1,NSAM
13900 IF(M1.LE.0)GO TO 316
14000 CCC IF(M1)316,316,315
14100 315 J4=L1+J3-1
14200 XIN1=FLOAT(I(J4))*SFI
14300 316 IF(M2.LE.0)GO TO 318
14400 CCC 316 IF(M2)318,318,317
14500 317 J5=L2+J3-1
14600 XIN2=FLOAT(I(J5))*SFI
14700 318 IF(SUM-XNFUN)320,319,319
14800 319 SUM=SUM-XNFUN
14900 I(7)=IABS (I(7)*IMULT)
15000 RN4=(2.*FLOAT(I(7))*SFF-1.)
15100 RN2=RN4-RN3
15200 RN1=RN3
15300 RN3=RN4
15400 GO TO 321
15500 320 RN2=RN3-RN1
15600 321 J7=L3+J3-1
15700 I(J7)=XIN1*(RN1+(RN2*SUM)/XNFUN)*SFID
15800 SUM=SUM+XIN2
15900 340 CONTINUE
16000 I(L4)=IFIX(SUM*SFID)
16100 I(L5)=IRN1
16200 I(L6)=IRN3
16300 RETURN
16400
16500 C ENVELOPE GENERATOR
16600 105 SUM=FLOAT(I(L7))*SFI
16700 IF(M1.GT.0)GO TO 381
16800 CCC IF(M1)380,380,381
16900 380 XIN1=FLOAT(I(L1))*SFI
17000 381 IF(M4.GT.0)GO TO 383
17100 CCC 381 IF(M4)382,382,383
17200 382 XIN4=FLOAT(I(L4))*SFI
17300 383 IF(M5.GT.0)GO TO 385
17400 CCC 383 IF(M5)384,384,385
17500 384 XIN5=FLOAT(I(L5))*SFI
17600 385 IF(M6.GT.0)GO TO 387
17700 CCC 385 IF(M6)386,386,387
17800 386 XIN6=FLOAT(I(L6))*SFI
17900 387 X1=XNFUN/4.
18000 X2=2.*X1
18100 X3=3.*X1
18200 DO 403 J3=1,NSAM
18300 J4=INT(SUM)+L2
18400 F=FLOAT(I(J4))
18500 IF(M1.LE.0)GO TO 405
18600 CCC IF(M1)405,405,404
18700 404 J8=L1+J3-1
18800 XIN1=FLOAT(I(J8))*SFI
18900 405 IF(SUM-XNFUN.LT.0)GO TO 389
19000 CCC 405 IF(SUM-XNFUN)389,388,388
19100 388 SUM=SUM-XNFUN
19200 389 IF(SUM-X1.GT.0)GO TO 393
19300 CCC 389 IF(SUM-X1)390,390,393
19400 390 IF(M4.LE.0)GO TO 392
19500 CCC 390 IF(M4)392,392,391
19600 391 J4=L4+J3-1
19700 XIN4=FLOAT(I(J4))*SFI
19800 392 SUM=SUM+XIN4
19900 GO TO 402
20000 393 IF(SUM-X2.GT.0)GO TO 397
20100 CCC 393 IF(SUM-X2)394,394,397
20200 394 IF(M5.LE.0)GO TO 396
20300 CCC 394 IF(M5)396,396,395
20400 395 J5=L5+J3-1
20500 XIN5=FLOAT(I(J5))*SFI
20600 396 SUM=SUM+XIN5
20700 GO TO 402
20800 397 IF(M6.LE.0)GO TO 400
20900 CCC 397 IF(M6)400,400,399
21000 399 J6=L6+J3-1
21100 XIN6=FLOAT(I(J6))*SFI
21200 400 SUM=SUM+XIN6
21300 402 J7=L3+J3-1
21400 I(J7)=IFIX(XIN1*F*SFXX)
21500 403 CONTINUE
21600 I(L7)=IFIX(SUM*SFID)
21700 RETURN
21800
21900 C STEREO OUTPUT BOX
22000 106 IF(M1.GT.0)GO TO 501
22100 CCC 106 IF(M1)500,500,501
22200 500 IN1=I(L1)
22300 501 IF(M2.GT.0)GO TO 503
22400 CCC 501 IF(M2)502,502,503
22500 502 IN2=I(L2)
22600 503 NSSAM=2*NSAM
22700 C 6/29/70 L.C.SMITH
22800 ICT=0
22900 DO 510 J3=1,NSSAM,2
23000 IF(M1.LE.0)GO TO 505
23100 CCC IF(M1)505,505,504
23200 CC*** 504 J4=L1+J3-1
23300 504 J4=L1+ICT
23400 IN1=I(J4)
23500 505 J5=L3+J3-1
23600 I(J5)=IN1+I(J5)
23700 IF(M2.LE.0)GO TO 507
23800 CCC IF(M2)507,507,506
23900 CC*** 506 J4=L2+J3-1
24000 506 J4=L2+ICT
24100 IN2=I(J4)
24200 507 J5=L3+J3
24300 I(J5)=IN2+I(J5)
24400 510 ICT=ICT+1
24500 RETURN
24600
24700 C ADD 3 BOX
24800 107 IF(M1.GT.0)GO TO 751
24900 CCC 107 IF(M1)750,750,751
25000 750 IN1=I(L1)
25100 751 IF(M2.GT.0)GO TO 753
25200 CCC 751 IF(M2)752,752,753
25300 752 IN2=I(L2)
25400 753 IF(M3.GT.0)GO TO 755
25500 CCC 753 IF(M3)754,754,755
25600 754 IN3=I(L3)
25700 755 DO 780 J3=1,NSAM
25800 IF(M1.LE.0)GO TO 757
25900 CCC IF(M1)757,757,756
26000 756 J4=L1+J3-1
26100 IN1=I(J4)
26200 757 IF(M2.LE.0)GO TO 759
26300 CCC 757 IF(M2)759,759,758
26400 758 J5=L2+J3-1
26500 IN2=I(J5)
26600 759 IF(M3.LE.0)GO TO 761
26700 CCC 759 IF(M3)761,761,760
26800 760 J6=L3+J3-1
26900 IN3=I(J6)
27000 761 J7=L4+J3-1
27100 I(J7)=IN1+IN2+IN3
27200 780 CONTINUE
27300 RETURN
27400
27500 C ADD 4 BOX
27600 108 IF(M1)850,850,851
27700 850 IN1=I(L1)
27800 851 IF(M2)852,852,853
27900 852 IN2=I(L2)
28000 853 IF(M3)854,854,855
28100 854 IN3=I(L3)
28200 855 IF(M4)856,856,857
28300 856 IN4=I(L4)
28400 857 DO 880 J3=1,NSAM
28500 IF(M1)859,859,858
28600 858 J4=L1+J3-1
28700 IN1=I(J4)
28800 859 IF(M2)861,861,860
28900 860 J5=L2+J3-1
29000 IN2=I(J5)
29100 861 IF(M3)863,863,862
29200 862 J6=L3+J3-1
29300 IN3=I(J6)
29400 863 IF(M4)865,865,864
29500 864 J7=L4+J3-1
29600 IN4=I(J7)
29700 865 J8=L5+J3-1
29800 I(J8)=IN1+IN2+IN3+IN4
29900 880 CONTINUE
30000 RETURN
30100 C MULTIPLIER
30200 109 IF(M1)900,900,901
30300 900 XIN1=FLOAT(I(L1))*SFI
30400 901 IF(M2)902,902,903
30500 902 XIN2=FLOAT(I(L2))*SFI
30600 903 DO 908 J3=1,NSAM
30700 IF(M1)905,905,904
30800 904 J4=L1+J3-1
30900 XIN1=FLOAT(I(J4))*SFI
31000 905 IF(M2)907,907,906
31100 906 J5=L2+J3-1
31200 XIN2=FLOAT(I(J5))*SFI
31300 907 J6=L3+J3-1
31400 I(J6)=XIN1*XIN2*SFID
31500 908 CONTINUE
31600 RETURN
31700
31800 C SET NEW FUNCTION IN OSC OR ENV
31900 110 ILOC=N1+6
32000 IF(INS(N1+1).EQ.105) ILOC=N1+4
32100 IN1=I(3)+INS(N1)-1
32200 CC IF(I(N1+1).EQ.105) ILOC=N1+4
32300 CC IN1=I(3)+I(N1)-1
32400 CC IIN1=I(IN1)/IP(12)
32500 IIN1=NT(IN1)/IP(12)
32600 IF(IIN1)960,960,955
32700 955 INS(ILOC)=-(IIN1-1)*IP(6)
32800 CC 955 I(ILOC)=-IP(2)-(IIN1-1)*IP(6)
32900 960 RETURN
33000
33100 C RANDOM AND HOLD GENERATOR
33200 111 SUM=FLOAT(I(L4))*SFI
33300 IF(M1)910,910,911
33400 910 XIN1=FLOAT(I(L1))*SFI
33500 911 IF(M2)912,912,913
33600 912 XIN2=FLOAT(I(L2))*SFI
33700 913 IRN=I(L5)
33800 DO 940 J3=1,NSAM
33900 IF(M1)916,916,915
34000 915 J4=L1+J3-1
34100 XIN1=FLOAT(I(J4))*SFI
34200 916 IF(M2)918,918,917
34300 917 J5=L2+J3-1
34400 XIN2=FLOAT(I(J5))*SFI
34500 918 IF(SUM-XNFUN)920,919,919
34600 919 SUM=SUM-XNFUN
34700 I(7)=IABS (I(7)*IMULT)
34800 RN=(2.*FLOAT(I(7))*SFF-1.)
34900 920 J7=L3+J3-1
35000 I(J7)=XIN1*RN*SFID
35100 SUM=SUM+XIN2
35200 940 CONTINUE
35300 I(L4)=IFIX(SUM*SFID)
35400 I(L5)=IRN
35500 RETURN
35600 END